The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/10/9/DISK1095.ZIP/EXPMNT.PRG

Text File | 1986-10-06 | 13KB | 375 lines

*
* EXPMNT
* CREATE AND MAINTAIN JOB HISTORY FILE FOR EMPLOYEES AND APPLICANTS
* SUPPORTS HIERARCHICAL FILE STRUCTURES: HEADER-LINE, PARENT-CHILD, ETC.
* FILE STRUCTURE MUST ALREADY EXIST
SET HEADING OFF
SET SAFETY OFF
SET STATUS OFF
CLEAR
CLEAR ALL
SET TALK OFF
SET BELL OFF
* DEFINE A STRING OF BLANKS
STORE SPACE(80) TO BLANK
* CLEAR REQUEST AND ACTION CONTROL VARIABLES
STORE " " TO REQUEST
STORE " " TO ACTION
*
*===============================START MODS: 1================================*
* SET NAME OF PRIMARY (PARENT) FILE                                          *
STORE "PERSONNL" TO FILENAME
* SET NAME OF SECONDARY (CHILD) FILE
STORE "EXPHIST" TO LINKNAME
* SETUP COUNT OF INDEXES FOR THE FILE filename
STORE 2 TO IXCOUNT
* SETUP CONSTANTS CONTAINING INDEXES IN SEQUENCE TO USE IN MACRO LATER.
* LIST EACH INDEX FIRST AS A PRIMARY INDEX. VARIABLES NAMED IXA, IXB, IXC, ETC.
STORE "PNAME,PSSAN" TO IXA
* DEFINE KEYS FOR INDEX. IF NUMERIC, MUST CONVERT WITH STR(). USE DI+IXA, ETC.
STORE "LAST_NAME-','-FIRST_NAME" TO DIIXA
STORE "PSSAN,PNAME" TO IXB
STORE "A->SSAN" TO DIIXB
* DEFINE KEY WHICH LINKS PARENT AND CHILD RECORDS DEFINED IN TERMS OF PARENT
* FILE FIELDS.
STORE "A->SSAN" TO DIPARENT
* DEFINE CORRESPONDING KEY IN TERMS OF PARENT RECORD FIELDS
* CHILD FILE INDEXING ONLY POSSIBLE IN PRESENCE OF PARENT
STORE "SSAN" TO DILINK
* STORE NAME OF CHILD FILE DATA ELEMENT TO CONTAIN THE LINKING KEY VALUE
STORE "SSAN" TO LINKKEY
* SETUP NAME OF INDEX FILE FOR THE LINKED FILE. MUST NOT BE SAME NAME AS A
* PARENT FILE INDEX
STORE "LPSSAN" TO IXLINK
*==================================END MODS==================================*
*
* SAVE NAME OF MACRO WHICH CONTAINS ACTIVE INDEX AS FIRST INDEX
STORE "IXA" TO LIVE_IX
* OPEN FILE WITHOUT INDEXES TO FIND RECORD COUNT
USE &FILENAME
COUNT TO RECCNT
**OPEN LINKED FILE WITHOUT INDEXES TO FIND RECORD COUNT
SELECT B
USE &LINKNAME
COUNT TO LINKCNT
STORE "N" TO DATAIN
* IF FILE IS EMPTY, ASSUME INDEXES NOT CREATED AND CREATE THEM
SELECT A
   STORE 1 TO COUNT
   DO WHILE COUNT<=IXCOUNT
      STORE "IX"+CHR(64+COUNT) TO TEMP
      STORE "DI"+TEMP TO TEMP2
      IF IXCOUNT>1
         STORE SUBSTR(&TEMP,1,AT(",",&TEMP)-1) TO TEMP
      ELSE
         STORE &TEMP TO TEMP
      ENDIF
      STORE &TEMP2 TO TEMP2
      INDEX ON &TEMP2 TO &TEMP
      STORE COUNT+1 TO COUNT
   ENDDO
* ADD INDEXES
SET INDEX TO &IXA
* POSITION AT FIRST RECORD IN LIVE INDEX SEQUENCE FOR INITIAL DISPLAY
GO TOP
* IF LINK FILE IS EMPTY, ASSUME INDEX NOT CREATED AND CREATE IT
SELECT B
   INDEX ON &DILINK TO &IXLINK
* ADD INDEX FOR LINKED FILE
SET INDEX TO &IXLINK
* POSITION LINKED FILE AT FIRST CHILD RECORD MATCHING KEY IN PARENT
SEEK DIPARENT
*
* MAIN UPDATE LOOP. TERMINATED BY 'M' AS REQUEST
DO WHILE REQUEST<>"M"
*  CLEAR RECORD DISPLAY AREA. TO SAVE TIME, COULD CLEAR ONLY LINES WITH
*  FIELDS FROM CHILD FILE
   STORE 16 TO COUNT
   DO WHILE COUNT<19
      @ COUNT,0 SAY BLANK
      STORE COUNT+1 TO COUNT
   ENDDO
*
*===============================START MODS: 2================================*
* DISPLAY SCREEN MASK: HEADING INFORMATION PLUS LABELS FOR EACH FIELD        *
   @ 1,22 SAY "SMITH'S BIKEWORKS INFORMATION SYSTEM"
   @ 3,11 SAY ">> Human Resources Management System File Maintenance <<"
   @ 5,17 SAY "Today's Date:"
   ?? DATE()
* SETUP VARIABLE PART OF MASK
   SELECT A
* ALL FOLLOWING FIELDS ARE FROM PARENT FILE
   @ 7,1  SAY "EMPLOYEE ? " GET HIRED
   @ 7,60 SAY "SSAN " GET SSAN
   @ 8,1 SAY "Name--Last  " GET LAST_NAME
   @ 8,36 SAY "First " GET FIRST_NAME
   @ 8,60 SAY "Initial " GET INITIAL
   @ 9,1  SAY "Street " GET STREET
   @ 9,36 SAY "City " GET CITY
   @ 9,59 SAY "State" GET STATE
   @ 9,69 SAY "Zip " GET ZIP
   @ 11,1  SAY "Education " GET   GRADE_SCHL
   @ 11,30 SAY "College " GET   COLLEGE
   @ 11,45 SAY "Phys Limits " GET   PHYS_LIMIT
   @ 12,1  SAY "Sex " GET   SEX
   @ 12,10 SAY "Marital Status " GET   MAR_STATUS
   @ 12,31 SAY "Birth Date " GET   BIRTH_DATE PICTURE "99/99/99"
   @ 13,1 SAY "Hourly ? " GET   HOURLY
   @ 13,14 SAY "Rate/Salary " GET   PAY_RATE
   @ 13,36 SAY "Overtime Factor " GET   OVER_TIME
   @ 13,59 SAY "Exemptions " GET   EXEMP
   @ 14,1  SAY "Year to Date -- Pay $"
   ?? A->YTD_PAY
   @ 14,35 SAY "Withholding $"
   ?? A->YTD_WTHHLD
   @ 14,60 SAY "FICA $"
   ?? A->YTD_FICA
*============================================================================
*
* ONLY CHILD RECORDS MAY BE ADDED OR EDITED
   CLEAR GETS
* SEE IF KEYS MATCH IN PARENT AND CHILD. IF NOT, TRY FIND ON SECONDARY FILE
   IF REQUEST = "<"
      SELECT B
      GO TOP
   ENDIF
   SELECT B
   IF (EOF() .OR. BOF()).OR.REQUEST<>"A".AND.A->SSAN<>B->SSAN
      STORE A->SSAN TO TEMP
      SEEK TEMP
   ENDIF
*
*================================START MODS: 3===============================*
*
* DISPLAY CHILD RECORD ONLY IF THERE IS ONE THAT MATCHES PARENT
* FIELDS RETRIEVED ARE FROM THE CHILD (SECONDARY) FILE
   IF .NOT. (EOF() .OR. BOF())
      @ 16,1  SAY "Work Code " GET   WORK_CODE
      @ 16,19 SAY "Title " GET   WORK_TITLE
      @ 16,49 SAY "Start " GET   START_DATE PICTURE "99/99/99"
      @ 16,65 SAY "End "   GET   END_DATE PICTURE "99/99/99"
      @ 17,1  SAY "By" GET   EMP_NAME
      @ 17,26 SAY "Strt" GET   EMP_STREET
      @ 17,52 SAY "City" GET   EMP_City
      @ 17,73 SAY "St" GET   EMP_STATE
   ENDIF
* DATE OF LAST UPDATE SHOULD BE ONE OF THE FIELDS (LAST_UPDT)
* BOTH PARENT AND CHILD FILES WILL BE ASSUMED TO CONTAIN LAST_UPDT FIELDS
   @ 18,1 SAY "Last Updated : "
   ?? A->LAST_UPDT, B->LAST_UPDT
*==================================END MODS==================================*
*
* DISPLAY VARIABLE DATA IN SCREEN HEADING
   IF DELETE()
      @ 5,1 SAY "* DELETED *"
   ELSE
      @ 5,1 SAY "           "
   ENDIF
* IDENTIFY RECORD
* USE PARENT RECORD RECORD NUMBER
   SELECT A
    @ 5,43 SAY "Record"
    @ 5,50 SAY RECNO()
    @ 5,62 SAY "of"
    @ 5,64 SAY RECCNT
* NOW MAKE SECONDARY FILE ACTIVE, SINCE EDITING OPERATIONS WILL BE ON THIS FILE
   SELECT B
* IF DATAIN FLAG SET, ACTIVATE THE GETS
   IF DATAIN="Y"
      @ 19,72 GET ACTION
      READ
* DATE STAMP CHILD RECORD
      REPLACE LAST_UPDT WITH DATE()
      IF REQUEST="E".OR.ACTION<>"C"
         STORE "N" TO DATAIN
         STORE " " TO REQUEST
         STORE " " TO ACTION
      ENDIF 2
   ELSE
      CLEAR GETS
   ENDIF 1
*
* DISPLAY CONTROL SUBMENU, CURRENT ACTIVE INDEX
   @ 19,0 SAY BLANK
   @ 20,0 SAY "----------------------------------------"
   @ 20,40 SAY "----------------------------------------"
   @ 21,0 CLEAR
   @ 21,2 SAY ;
"<F>ind Record  <A>dd Record   <D>elete/Recall  <E>dit Record   Current Active"
   @ 22,2 SAY ;
"<P>rev Record  <N>ext Record  <M>enu (return)  <K>ey Select    Key:          "
   @ 23,2 SAY ;
"< prev, next linked record >"
* IF INDEX SET NAMED IN LIVE_IX HAS MULTIPLE ENTRIES, EXTRACT FIRST
   IF (","$&LIVE_IX)
      STORE SUBSTR(&LIVE_IX,1,AT(",",&LIVE_IX)-1) TO TEMP
      @ 22,70 SAY TEMP
   ELSE
      @ 22,70 SAY &LIVE_IX
   ENDIF
* GET REQUEST AND FORCE TO UPPER CASE UNLESS ALREADY IN 'A' FOR ADD RECORDS
   IF REQUEST<>"A"
      STORE " " TO REQUEST
      STORE " " TO ACTION
      @ 23,35 SAY "*** NEXT ACTION TO PERFORM " GET REQUEST
      READ
      STORE UPPER(REQUEST) TO REQUEST
   ENDIF
* CLEAR ADD RECORD COMMAND LINE, SUBMENU AREA
   @ 21,0 CLEAR
   DO CASE
* ADD NEW CASE OR EDIT DISPLAYED CASE
      CASE REQUEST="A".OR.REQUEST="E"
* WILL ADD CHILD RECORD. CAN ONLY ADD IF THERE IS AT LEAST ONE PARENT
         IF RECCNT>0
            SELECT B
* IN ADD MODE, APPEND A BLANK RECORD FOR THE DATA AND POSITION TO THAT RECORD
            IF REQUEST="A"
               @ 19,6 SAY "*** PRESS 'C' TO CONTINUE ADDING NEW RECS, ANYTHING;
 ELSE TO QUIT"
               APPEND BLANK
               STORE LINKCNT+1 TO LINKCNT
               GO LINKCNT
* SETUP PARENT RECORD KEY VALUE IN CHILD RECORD
               REPLACE &LINKKEY WITH &DIPARENT
            ELSE
               @ 19,6 SAY "******** PRESS ANY KEY TO FINISH EDIT AND RETURN TO;
 SUBMENU     "
            ENDIF
           @ 21,10 SAY "Enter data at cursor position. Move among fields with"
           @ 22,10 SAY "cursor control keys. Press ENTER to move to next field"
           @ 23,10 SAY "Press ENTER alone to leave field unchanged."
* SET FLAG TO CAUSE NEW DATA TO BE READ
            STORE "Y" TO DATAIN
         ENDIF
* TOGGLE DELETE FLAG. * FUNCTION CHECKS IF RECORD NOW FLAGGED AS DELETED
      CASE REQUEST="D"
         IF DELETE()
            RECALL
         ELSE
            DELETE
         ENDIF
* PREVIOUS RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="P"
         SELECT A
         SKIP -1
* NEXT THREE LINES SECURE THE BACKWARD LOOP
         IF BOF()
            GO BOTTOM
         ENDIF
         SELECT B
* NEXT RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="N"
         SELECT A
         SKIP +1
* NEXT THREE LINES SECURE THE FOWARD LOOP
         IF EOF()
            GO TOP
         ENDIF
         SELECT B
* PREVIOUS CHILD RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST="<"
* SAVE CURRENT LOCATION TO SEE IF AT BEGINNING
         STORE RECNO() TO RECNOW
* NEXT THREE LINES SECURE THE BACKWARD LOOP
         IF BOF()
            GO BOTTOM
         ELSE
            SKIP -1
         ENDIF
* IF PARENT AND CHILD DON'T MATCH, OR AT BEGINNING OF CHILD FILE, BACKUP PARENT
         IF A->SSAN<>B->SSAN.OR.BOF()
            SELECT A
            SKIP -1
* NEXT THREE LINES SECURE THE BACKWARD LOOP
            IF BOF()
               GO BOTTOM
            ENDIF
            SELECT B
         ENDIF
* NEXT CHILD RECORD IN ACTIVE INDEX SEQUENCE
      CASE REQUEST=">"
* SAVE CURRENT LOCATION TO SEE IF AT BEGINNING
         STORE RECNO() TO RECNOW
* NEXT THREE LINES SECURE THE FOWARD LOOP
         IF EOF()
            GO TOP
         ELSE
            SKIP +1
         ENDIF
**IF PARENT AND CHILD DON'T MATCH, OR AT END OF CHILD FILE, ADVANCE PARENT
         IF A->SSAN<>B->SSAN
            SELECT A
            SKIP +1
* NEXT THREE LINES SECURE THE FOWARD LOOP
            IF EOF()
               GO TOP
            ENDIF
            SELECT B
         ENDIF
* GET SEARCH VALUE FOR INDEXED SEARCH
      CASE REQUEST="F"
         SELECT A
* USE MACRO DEFINING INDEX ENTRIES FROM DATA FIELDS
         STORE "DI"+LIVE_IX TO IXDEF
         STORE &IXDEF TO SV
         STORE &SV TO SV
         @ 21,1 SAY ;
         "ENTER SEARCH VALUE. VALUE SHOWN IS FROM THE DISPLAYED RECORD. PRESS"
         @ 22,1 SAY "CTRL-Y TO CLEAR " GET SV
         READ
* REMOVE TRAILING BLANKS BEFORE SEARCH
         STORE TRIM(SV) TO SEARCH
* IF RECORD IS NOT FOUND POSITION STAYS AT CURRENT RECORD
* FIND IS IN PARENT FILE
         SELECT A
* NEXT LINE KEEPS TRACK OF CURRENT RECNO() FOR TEST BELOW
         STORE RECNO() TO NOW
         SEEK SEARCH
* NEXT 3 LINES KEEP PRESENT RECORD DISPLAYED IF NO FIND.
         IF EOF()
            GOTO NOW
         ENDIF
         SELECT B
* CHANGE INDEX
      CASE REQUEST="K"
* MUST POINT TO PARENT FILE WHILE INDEX IS CHANGED
         SELECT A
         STORE RECNO() TO RECNOW
         STORE " " TO IXCHOICE
* SETUP MENU OF INDEX NAMES, PROVIDE IF CLAUSE FOR EACH INDEX                *
         @ 21,9 SAY " "
         STORE 1 TO COUNT
         DO WHILE COUNT<=IXCOUNT
            STORE "IX"+CHR(64+COUNT) TO TEMP
            IF IXCOUNT>1
               ?? CHR(64+COUNT)+". "+SUBSTR(&TEMP,1,AT(",",&TEMP)-1)+" "
            ELSE
               ?? CHR(64+COUNT)+". "+&TEMP
            ENDIF
            STORE COUNT+1 TO COUNT
         ENDDO
         @ 22,10 SAY "Press letter of desired key " GET IXCHOICE
         READ
         STORE UPPER(IXCHOICE) TO IXCHOICE
         IF IXCHOICE>="A".AND.IXCHOICE<=CHR(64+IXCOUNT)
            STORE "IX"+IXCHOICE TO LIVE_IX
            STORE &LIVE_IX TO TEMP
            SET INDEX TO &TEMP
         ENDIF
* GOTO THIS RECORD TO ACTIVATE INDEX
         IF RECNOW>0
            GO RECNOW
         ELSE
            GO BOTTOM
         ENDIF
* MAKE SECONDARY FILE ACTIVE AGAIN
         SELECT B
   ENDCASE
ENDDO
* FALL OUT OF DO WHEN 'M' IS REQUEST, RETURN TO SUBSYSTEM'S MENU
CLEAR
RETURN